Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- unit colorscheme;
- {$mode objfpc}{$H+}
- {$modeswitch AdvancedRecords}
- interface
- uses
- SysUtils, Classes,
- Forms, Controls, Graphics, Dialogs, StdCtrls,
- Menus, ExtCtrls, SynEdit, SynEditTypes, ColorBox, Buttons,
- newsimbasettings;
- type
- EEditorAttr = (
- ecGutter, ecGutterLineNumberPart, ecGutterChangesPart, ecGutterCodeFoldPart,
- ecGutterMarksPart, ecGutterSeparatorPart,
- ecEdtior, ecRightEdge, ecLineHighlight, ecFoldedCode, ecFoldedCodeLine, ecBracketMatch,
- ecAttrAsm, ecAttrCase, ecAttrComment, ecAttrPreProc, ecAttrPreProc2, ecAttrIdent,
- ecAttrNumber, ecAttrReserved, ecAttrSpacing, ecAttrString, ecAttrOperator,
- ecCaretMark
- );
- TFrameStyle = record
- Color: TColor;
- Style: TSynLineStyle;
- Edges: TSynFrameEdges;
- end;
- TStyleAndColor = record
- Foreground: TColor;
- Background: TColor;
- Style: TFontStyles;
- Frame: TFrameStyle;
- end;
- TColorScheme = class(TForm)
- public
- SimbaSettings: TSimbaSettings;
- List: TListBox;
- Splitter: TSplitter;
- Editor: TSynEdit;
- TopPanel, BtmPanel: TPanel;
- LabelFG, LabelBG: TLabel;
- SelectFG, SelectBG: TColorBox;
- CustomFGbtn, CustomBGbtn: TSpeedButton;
- CustomFG, CustomBG: TColorDialog;
- CheckBold, CheckItalic, CheckUnderline: TCheckBox;
- Scheme: array [EEditorAttr] of TStyleAndColor;
- DefaultScheme: array [EEditorAttr] of TStyleAndColor;
- constructor Create(TheOwner: TComponent; TheSettings: TSimbaSettings); reintroduce;
- procedure LoadDefaults();
- procedure UpdateEditor();
- procedure OnSelectionChange(Sender: TObject; User: Boolean);
- procedure OnSelectBG(Sender: TObject);
- procedure OnSelectFG(Sender: TObject);
- procedure OnBoldChange(Sender: TObject);
- procedure OnItalicChange(Sender: TObject);
- procedure OnUnderlineChange(Sender: TObject);
- end;
- implementation
- uses
- SynHighlighterLape, LResources, SimbaUnit;
- resourcestring
- ExampleText =
- 'program Highlight; '+ LineEnding +
- '{comment} '+ LineEnding +
- '{$I SRL/osr.simba} '+ LineEnding +
- ' '+ LineEnding +
- '// this function does stuff '+ LineEnding +
- 'procedure Test(); '+ LineEnding +
- 'var '+ LineEnding +
- ' x: Int32; '+ LineEnding +
- ' s: String; '+ LineEnding +
- 'begin '+ LineEnding +
- ' x := 1000 * (5 + 7); '+ LineEnding +
- ' s := '+#39+'The number is :'+#39+' +ToStr(x); '+ LineEnding +
- ' asm '+ LineEnding +
- ' mov AX 1234h; '+ LineEnding +
- ' mov Number, AX; '+ LineEnding +
- ' end; '+ LineEnding +
- ' '+ LineEnding +
- ' Inc(x); '+ LineEnding +
- ' {$R+} '+ LineEnding +
- ' case x of '+ LineEnding +
- ' 1: ; '+ LineEnding +
- ' 2: ; '+ LineEnding +
- ' 3: ; '+ LineEnding +
- ' end; '+ LineEnding +
- 'end; ';
- // -----------------------------------------------------------------------------
- procedure TColorscheme.LoadDefaults();
- var i: Int32;
- begin
- DefaultScheme[ecGutter].Background := Editor.Gutter.Color;
- DefaultScheme[ecGutterLineNumberPart].Foreground := Editor.Gutter.LineNumberPart.MarkupInfo.Foreground;
- DefaultScheme[ecGutterLineNumberPart].Background := Editor.Gutter.LineNumberPart.MarkupInfo.Background;
- DefaultScheme[ecGutterLineNumberPart].Style := Editor.Gutter.LineNumberPart.MarkupInfo.Style;
- DefaultScheme[ecGutterChangesPart].Foreground := Editor.Gutter.ChangesPart.MarkupInfo.Foreground;
- DefaultScheme[ecGutterChangesPart].Background := Editor.Gutter.ChangesPart.MarkupInfo.Background;
- DefaultScheme[ecGutterChangesPart].Style := Editor.Gutter.ChangesPart.MarkupInfo.Style;
- DefaultScheme[ecGutterCodeFoldPart].Foreground := Editor.Gutter.CodeFoldPart.MarkupInfo.Foreground;
- DefaultScheme[ecGutterCodeFoldPart].Background := Editor.Gutter.CodeFoldPart.MarkupInfo.Background;
- DefaultScheme[ecGutterCodeFoldPart].Style := Editor.Gutter.CodeFoldPart.MarkupInfo.Style;
- DefaultScheme[ecGutterMarksPart].Foreground := Editor.Gutter.MarksPart.MarkupInfo.Foreground;
- DefaultScheme[ecGutterMarksPart].Background := Editor.Gutter.MarksPart.MarkupInfo.Background;
- DefaultScheme[ecGutterMarksPart].Style := Editor.Gutter.MarksPart.MarkupInfo.Style;
- DefaultScheme[ecGutterMarksPart].Foreground := Editor.Gutter.SeparatorPart.MarkupInfo.Foreground;
- DefaultScheme[ecGutterMarksPart].Background := Editor.Gutter.SeparatorPart.MarkupInfo.Background;
- DefaultScheme[ecGutterMarksPart].Style := Editor.Gutter.SeparatorPart.MarkupInfo.Style;
- // general editor
- DefaultScheme[ecEdtior].Background := Editor.Color;
- DefaultScheme[ecRightEdge].Foreground := Editor.RightEdgeColor;
- DefaultScheme[ecLineHighlight].Foreground := Editor.LineHighlightColor.Foreground;
- DefaultScheme[ecLineHighlight].Background := Editor.LineHighlightColor.Background;
- DefaultScheme[ecLineHighlight].Style := Editor.LineHighlightColor.Style;
- DefaultScheme[ecFoldedCode].Foreground := Editor.FoldedCodeColor.Foreground;
- DefaultScheme[ecFoldedCode].Background := Editor.FoldedCodeColor.Background;
- DefaultScheme[ecFoldedCode].Style := Editor.FoldedCodeColor.Style;
- DefaultScheme[ecFoldedCodeLine].Foreground := Editor.FoldedCodeLineColor.Foreground;
- DefaultScheme[ecFoldedCodeLine].Background := Editor.FoldedCodeLineColor.Background;
- DefaultScheme[ecFoldedCodeLine].Style := Editor.FoldedCodeLineColor.Style;
- DefaultScheme[ecBracketMatch].Foreground := Editor.BracketMatchColor.Foreground;
- DefaultScheme[ecBracketMatch].Background := Editor.BracketMatchColor.Background;
- DefaultScheme[ecBracketMatch].Style := Editor.BracketMatchColor.Style;
- // attributes
- for i:=0 to 10 do
- begin
- DefaultScheme[EEditorAttr(Ord(ecAttrAsm)+i)].Foreground := Editor.Highlighter.Attribute[i].Foreground;
- DefaultScheme[EEditorAttr(Ord(ecAttrAsm)+i)].Background := Editor.Highlighter.Attribute[i].Background;
- DefaultScheme[EEditorAttr(Ord(ecAttrAsm)+i)].Style := Editor.Highlighter.Attribute[i].Style;
- DefaultScheme[EEditorAttr(Ord(ecAttrAsm)+i)].Frame.Edges := Editor.Highlighter.Attribute[i].FrameEdges;
- DefaultScheme[EEditorAttr(Ord(ecAttrAsm)+i)].Frame.Color := Editor.Highlighter.Attribute[i].FrameColor;
- DefaultScheme[EEditorAttr(Ord(ecAttrAsm)+i)].Frame.Style := Editor.Highlighter.Attribute[i].FrameStyle;
- end;
- // word match highlight
- //DefaultScheme[ecCaretMark].DefaultForeground := MarkCaret.Foreground;
- //DefaultScheme[ecCaretMark].DefaultBackground := MarkCaret.Background;
- //DefaultScheme[ecCaretMark].DefaultStyle := MarkCaret.Style;
- Scheme := DefaultScheme;
- end;
- procedure TColorscheme.UpdateEditor();
- var i: Int32;
- begin
- // gutter
- Editor.Gutter.Color := Scheme[ecGutter].Background;
- Editor.Gutter.LineNumberPart.MarkupInfo.Foreground := Scheme[ecGutterLineNumberPart].Foreground;
- Editor.Gutter.LineNumberPart.MarkupInfo.Background := Scheme[ecGutterLineNumberPart].Background;
- Editor.Gutter.LineNumberPart.MarkupInfo.Style := Scheme[ecGutterLineNumberPart].Style;
- Editor.Gutter.ChangesPart.MarkupInfo.Foreground := Scheme[ecGutterChangesPart].Foreground;
- Editor.Gutter.ChangesPart.MarkupInfo.Background := Scheme[ecGutterChangesPart].Background;
- Editor.Gutter.ChangesPart.MarkupInfo.Style := Scheme[ecGutterChangesPart].Style;
- Editor.Gutter.CodeFoldPart.MarkupInfo.Foreground := Scheme[ecGutterCodeFoldPart].Foreground;
- Editor.Gutter.CodeFoldPart.MarkupInfo.Background := Scheme[ecGutterCodeFoldPart].Background;
- Editor.Gutter.CodeFoldPart.MarkupInfo.Style := Scheme[ecGutterCodeFoldPart].Style;
- Editor.Gutter.MarksPart.MarkupInfo.Foreground := Scheme[ecGutterMarksPart].Foreground;
- Editor.Gutter.MarksPart.MarkupInfo.Background := Scheme[ecGutterMarksPart].Background;
- Editor.Gutter.MarksPart.MarkupInfo.Style := Scheme[ecGutterMarksPart].Style;
- Editor.Gutter.SeparatorPart.MarkupInfo.Foreground := Scheme[ecGutterMarksPart].Foreground;
- Editor.Gutter.SeparatorPart.MarkupInfo.Background := Scheme[ecGutterMarksPart].Background;
- Editor.Gutter.SeparatorPart.MarkupInfo.Style := Scheme[ecGutterMarksPart].Style;
- // general editor
- Editor.Color := Scheme[ecEdtior].Background;
- Editor.RightEdgeColor := Scheme[ecRightEdge].Foreground;
- Editor.LineHighlightColor.Foreground := Scheme[ecLineHighlight].Foreground;
- Editor.LineHighlightColor.Background := Scheme[ecLineHighlight].Background;
- Editor.LineHighlightColor.Style := Scheme[ecLineHighlight].Style;
- Editor.FoldedCodeColor.Foreground := Scheme[ecFoldedCode].Foreground;
- Editor.FoldedCodeColor.Background := Scheme[ecFoldedCode].Background;
- Editor.FoldedCodeColor.Style := Scheme[ecFoldedCode].Style;
- Editor.FoldedCodeLineColor.Foreground := Scheme[ecFoldedCodeLine].Foreground;
- Editor.FoldedCodeLineColor.Background := Scheme[ecFoldedCodeLine].Background;
- Editor.FoldedCodeLineColor.Style := Scheme[ecFoldedCodeLine].Style;
- Editor.BracketMatchColor.Foreground := Scheme[ecBracketMatch].Foreground;
- Editor.BracketMatchColor.Background := Scheme[ecBracketMatch].Background;
- Editor.BracketMatchColor.Style := Scheme[ecBracketMatch].Style;
- // attributes
- for i:=0 to 10 do
- begin
- Editor.Highlighter.Attribute[i].Foreground := Scheme[EEditorAttr(Ord(ecAttrAsm)+i)].Foreground;
- Editor.Highlighter.Attribute[i].Background := Scheme[EEditorAttr(Ord(ecAttrAsm)+i)].Background;
- Editor.Highlighter.Attribute[i].Style := Scheme[EEditorAttr(Ord(ecAttrAsm)+i)].Style;
- Editor.Highlighter.Attribute[i].FrameEdges := Scheme[EEditorAttr(Ord(ecAttrAsm)+i)].Frame.Edges;
- Editor.Highlighter.Attribute[i].FrameColor := Scheme[EEditorAttr(Ord(ecAttrAsm)+i)].Frame.Color;
- Editor.Highlighter.Attribute[i].FrameStyle := Scheme[EEditorAttr(Ord(ecAttrAsm)+i)].Frame.Style;
- end;
- // word match highlight
- //MarkCaret.Foreground := Scheme[ecCaretMark].Foreground;
- //MarkCaret.Background := Scheme[ecCaretMark].Background;
- //MarkCaret.Style := Scheme[ecCaretMark].Style;
- //MarkCaret.FrameEdges := Scheme[ecCaretMark].Frame.Edges;
- //MarkCaret.FrameColor := Scheme[ecCaretMark].Frame.Color;
- //MarkCaret.FrameStyle := Scheme[ecCaretMark].Frame.Style;
- end;
- procedure TColorscheme.OnSelectionChange(Sender: TObject; User: boolean);
- var
- currSelection,i: Int32;
- begin
- currSelection := List.ItemIndex;
- if (SelectFG = nil) or (SelectBG = nil) then
- Exit;
- i := SelectFG.Items.IndexOfObject(TObject(PtrInt(Scheme[EEditorAttr(currSelection)].Foreground)));
- if (i = -1) then
- begin
- SelectFG.ItemIndex := SelectFG.Items.Count-1;
- SelectFG.Items.Objects[SelectFG.ItemIndex] := TObject(PtrInt(DefaultScheme[EEditorAttr(currSelection)].Foreground));
- end;
- i := SelectBG.Items.IndexOfObject(TObject(PtrInt(Scheme[EEditorAttr(currSelection)].Background)));
- if (i = -1) then
- begin
- SelectBG.ItemIndex := SelectBG.Items.Count-1;
- SelectBG.Items.Objects[SelectBG.ItemIndex] := TObject(PtrInt(DefaultScheme[EEditorAttr(currSelection)].Background));
- end;
- CheckBold.Checked := fsBold in Scheme[EEditorAttr(currSelection)].Style;
- CheckItalic.Checked := fsItalic in Scheme[EEditorAttr(currSelection)].Style;
- CheckUnderline.Checked := fsUnderline in Scheme[EEditorAttr(currSelection)].Style;
- SelectFG.Update;
- SelectBG.Update;
- end;
- procedure TColorscheme.OnSelectFG(Sender: TObject);
- begin
- if SelectFG.ItemIndex = SelectFG.Items.Count-1 then
- Scheme[EEditorAttr(List.ItemIndex)].Foreground := DefaultScheme[EEditorAttr(List.ItemIndex)].Foreground
- else
- Scheme[EEditorAttr(List.ItemIndex)].Foreground := SelectFG.Selected;
- UpdateEditor();
- end;
- procedure TColorscheme.OnSelectBG(Sender: TObject);
- begin
- if SelectBG.ItemIndex = SelectBG.Items.Count-1 then
- Scheme[EEditorAttr(List.ItemIndex)].Background := DefaultScheme[EEditorAttr(List.ItemIndex)].Background
- else
- Scheme[EEditorAttr(List.ItemIndex)].Background := SelectBG.Selected;
- UpdateEditor();
- end;
- procedure TColorscheme.OnBoldChange(Sender: TObject);
- begin
- with Scheme[EEditorAttr(List.ItemIndex)] do
- if CheckBold.Checked then Style := Style + [fsBold]
- else Style := Style - [fsBold];
- UpdateEditor();
- end;
- procedure TColorscheme.OnItalicChange(Sender: TObject);
- begin
- with Scheme[EEditorAttr(List.ItemIndex)] do
- if CheckItalic.Checked then Style := Style + [fsItalic]
- else Style := Style - [fsItalic];
- UpdateEditor();
- end;
- procedure TColorscheme.OnUnderlineChange(Sender: TObject);
- begin
- with Scheme[EEditorAttr(List.ItemIndex)] do
- if CheckUnderline.Checked then Style := Style + [fsUnderline]
- else Style := Style - [fsUnderline];
- UpdateEditor();
- end;
- constructor TColorscheme.Create(TheOwner: TComponent; TheSettings: TSimbaSettings);
- var i: Int32;
- begin
- inherited Create(TheOwner);
- Caption := 'Simba colors';
- SimbaSettings := TheSettings;
- Width := 800;
- Height := 600;
- Position := poMainFormCenter;
- // Top portion
- TopPanel := TPanel.Create(Self);
- with TopPanel do
- begin
- Parent := Self;
- Width := Self.Width;
- Height := Round(Self.Height * 0.5);
- Align := alTop;
- end;
- Editor := TSynEdit.Create(TopPanel);
- with Editor do
- begin
- Parent := TopPanel;
- Align := alRight;
- Width := Round(Self.Width * 0.8);
- Font.Assign(SimbaSettings.SourceEditor.Font.Value);
- Highlighter := TSynFreePascalSyn.Create(Editor);
- Editor.Text := ExampleText;
- end;
- Splitter := TSplitter.Create(TopPanel);
- with Splitter do
- begin
- Parent := TopPanel;
- Align := alLeft;
- end;
- List := TListBox.Create(TopPanel);
- List.OnSelectionChange := @Self.OnSelectionChange;
- with List do
- begin
- Parent := TopPanel;
- Align := alLeft;
- Width := Round(Self.Width * 0.19);
- Items.Add('Gutter');
- Items.Add(' Linenumber');
- Items.Add(' Changes');
- Items.Add(' CodeFold');
- Items.Add(' Marks');
- Items.Add(' Separator');
- Items.Add('Editor');
- Items.Add(' Right Edge');
- Items.Add(' LineHighlight');
- Items.Add(' Folded Code');
- Items.Add(' Folded Code Line');
- Items.Add(' Backet Match');
- Items.Add('Assembler');
- Items.Add('Case label');
- Items.Add('Comment');
- Items.Add('Pre processor');
- Items.Add('IDE directive');
- Items.Add('Identifiers');
- Items.Add('Numbers');
- Items.Add('Reserved word');
- Items.Add('Spaces');
- Items.Add('Strings');
- Items.Add('Operator');
- List.ItemIndex := 0;
- end;
- // The bottom portion:
- BtmPanel := TPanel.Create(Self);
- with BtmPanel do
- begin
- Parent := Self;
- Width := Self.Width;
- align := alBottom;
- Height := Round(Self.Height * 0.5);
- BevelColor:=clLtGray;
- BevelWidth:=4;
- end;
- // Colorlists
- LabelFG := TLabel.Create(BtmPanel);
- LabelBG := TLabel.Create(BtmPanel);
- with LabelFG do
- begin
- Parent := BtmPanel;
- Caption := 'Foreground';
- Left := 9;
- Top := 12;
- end;
- with LabelBG do
- begin
- Parent := BtmPanel;
- Caption := 'Background';
- Left := 9;
- Top := 40;
- end;
- SelectFG := TColorBox.Create(BtmPanel);
- SelectBG := TColorBox.Create(BtmPanel);
- with SelectFG do
- begin
- Parent := BtmPanel;
- OnChange := @Self.OnSelectFG;
- Style := [cbStandardColors,cbExtendedColors,cbSystemColors,cbCustomColor,cbPrettyNames,cbCustomColors];
- Left := 100;
- Top := 8;
- Width := 150;
- Items.Objects[Items.Add('Default')] := TObject(PtrInt(-1));
- end;
- with SelectBG do
- begin
- Parent := BtmPanel;
- OnChange := @Self.OnSelectBG;
- Style := [cbStandardColors,cbExtendedColors,cbSystemColors,cbCustomColor,cbPrettyNames,cbCustomColors];
- Left := 100;
- Top := 36;
- Width := 150;
- Items.Objects[Items.Add('Default')] := TObject(PtrInt(-1));
- end;
- // The checkboxes
- CheckBold := TCheckBox.Create(BtmPanel);
- CheckItalic := TCheckBox.Create(BtmPanel);
- CheckUnderline := TCheckBox.Create(BtmPanel);
- with CheckBold do
- begin
- Parent := BtmPanel;
- Left := 300;
- Top := 8;
- Caption:= 'Bold';
- CheckBold.OnChange := @Self.OnBoldChange;
- end;
- with CheckItalic do
- begin
- Parent := BtmPanel;
- Left := 300;
- Top := 36;
- Caption:= 'Italic';
- CheckItalic.OnChange := @Self.OnItalicChange;
- end;
- with CheckUnderline do
- begin
- Parent := BtmPanel;
- Left := 300;
- Top := 64;
- Caption:= 'Underline';
- CheckUnderline.OnChange := @Self.OnUnderlineChange;
- end;
- LoadDefaults();
- end;
- end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement