delphi - Sæt 'lokal' font - Udvikleren.dk - Programmering, webdesign og grafik

Tags: delphi

Bruger #8985 @ 27.05.06 21:30

Hej,

Jeg er ved at lave et program som notesblokken, men det skal dog kunne en minimal smule mere. Det skal bl. a. være, så man kan markere en del af den tekst, man skriver, og så enten i en dialog boks eller ved at trykke på en knap skifter farven / skrifttypen, på den tekst man har markeret.

Jeg er lige startet på Delphi, så I må ikke grine af min kode

Unit1.pas

Kode

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, ComCtrls, ToolWin, ExtCtrls, jpeg;

type
  TForm1 = class(TForm)
  menu: TMainMenu;
  filer: TMenuItem;
  ny: TMenuItem;
  afslut: TMenuItem;
  rediger: TMenuItem;
  formater: TMenuItem;
  vis: TMenuItem;
  sti: TMenuItem;
  hjaelp: TMenuItem;
  skriv: TRichEdit;
  top: TToolbar;
  bund: TLabel;
  skrifttype: TMenuItem;
  verdana: TMenuItem;
  eltekst: TMenuItem;
  markeralt: TMenuItem;
  cboard: TMenuItem;
  paste: TMenuItem;
  ombrydning: TMenuItem;
  html: TMenuItem;
  OpenDialog1: TOpenDialog;
  SaveDialog1: TSaveDialog;
  aaben: TMenuItem;
  gem: TMenuItem;
  gemsom: TMenuItem;
  Image1: TImage;
  procedure luk(Sender: TObject);
  procedure fil(Sender: TObject);
  procedure hr(Sender: TObject);
  procedure br(Sender: TObject);
  procedure programsti(Sender: TObject);
  procedure nyside(Sender: TObject);
  procedure setverdana(Sender: TObject);
  procedure setcourier(Sender: TObject);
  procedure marker(Sender: TObject);
  procedure kopier(Sender: TObject);
  procedure indsaet(Sender: TObject);
  procedure bryd(Sender: TObject);
  procedure udregn(Sender: Tobject);
  procedure tom(Sender: TObject);
  procedure downloadsite(Sender: TObject);
  procedure open(Sender: TObject);
  procedure save(Sender: TObject);
  procedure saveas(Sender: TObject);
  
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  tal: integer;
  dlsite: string;
  markerettekst: string;
  open: TOpenDialog;

implementation

procedure TForm1.tom(Sender: TObject);
begin
        skriv.Text := '';
end;

procedure TForm1.udregn(Sender: TObject);
begin
        ShowMessage(skriv.Text);
end;

procedure TForm1.bryd(Sender: TObject);
begin
        if skriv.WordWrap = True then
        begin
                skriv.WordWrap := False;
                skriv.ScrollBars := ssBoth;
                ombrydning.Checked := False;
        end
        else
        begin
                skriv.WordWrap := True;
                skriv.ScrollBars := ssVertical;
                ombrydning.Checked := True;
        end
end;
procedure TForm1.hr(Sender: TObject);
begin
        skriv.SelText := '<hr>';
end;
procedure TForm1.br(Sender: TObject);
begin
        skriv.SelText := '<br>';
end;
procedure TForm1.fil(Sender: TObject);
begin
        ShowMessage('Dette er den absolutte sti til programmet:'+#10+Application.ExeName);
end;
procedure TForm1.programsti(Sender: TObject);
begin
        skriv.SelText := Application.ExeName;
end;
procedure TForm1.nyside(Sender: TObject);
begin
        skriv.Text := '';
        skriv.SelText := '<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">'+#10+'<html>'+#10+'<head>'+#10+'<meta http-equiv="Content-Language" content="da">'+#10+'<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1">'+#10+'<title>Dokumentets titel</title>'+#10+'</head>'+#10+'<body>'+#10#10+'</body>'+#10+'</html>';
end;
procedure TForm1.setverdana(Sender: TObject);
begin
        skriv.Font.Name := 'Verdana';
        skriv.SelStart := 5;
end;
procedure TForm1.setcourier(Sender: TObject);
begin
        skriv.Font.Name := 'Courier New';
end;
procedure TForm1.marker(Sender: TObject);
begin
        if skriv.Text <> '' then
        begin
                skriv.SelectAll;
        end
        else
        begin
                ShowMessage('Denne funktion kræver, du har skrevet noget tekst');
        end;
end;
procedure TForm1.kopier(Sender: TObject);
begin
        if skriv.SelLength <> 0 then
        begin
                skriv.CopyToClipBoard;
        end
        else
        begin
                ShowMessage('Du skal markere den tekst, du vil kopiere');
        end;
end;
procedure TForm1.indsaet(Sender: TObject);
begin
        skriv.PasteFromClipboard;
end;

procedure TForm1.luk(Sender: TObject);
begin
        if Application.MessageBox('Er du sikker på, du vil lukke MonsterWare WebEdit 1 (uregistreret)?', 'MonsterWare WebEdit 1', MB_YESNO) = IDNO then
        begin
                Application.Run;
        end
        else
        begin
                Application.Terminate;
        end;
end;
procedure TForm1.downloadsite(Sender: TObject);
begin
        if skriv.Text = '[download site]' then
        begin
             skriv.ReadOnly := True;
             skriv.Text := '';
             skriv.SelText := 'http://www.thebravery.hotserv.dk/WebEdit.exe';
             skriv.ReadOnly := False;
        end
        else if skriv.Text = '[program close]' then
        begin
                Application.Terminate;
        end
        else if Pos('[linier]', skriv.Text) > 0 then
        begin
                ShowMessage(IntToStr(skriv.Lines.Count));
        end
        else if Pos('[save file]', skriv.Text) > 0 then
        begin
                skriv.Lines.SaveToFile('C:\\Documents and Settings\\Thomas Kappel\\Skrivebord\\hej.txt');
                ShowMessage('Saved and applied');
        end;
        bund.Alignment := taLeftJustify;
        bund.Caption := 'Antal linier: '+IntToStr(skriv.Lines.Count);
        if skriv.Text = '' then
        begin
                bund.Alignment := taCenter;
                bund.Caption := 'Copyright Thomas Juhl Kappel 2006';
        end;
end;
procedure TForm1.open(Sender: TObject);
begin
        if OpenDialog1.Execute then
        begin
                skriv.Text := '';
                skriv.Lines.LoadFromFile(OpenDialog1.Filename);
        end;
end;
procedure TForm1.save(Sender: TObject);
begin
        skriv.Lines.SaveToFile('C:\\Documents and Settings\\Thomas Kappel\\Skrivebord\\test.txt');
end;
procedure TForm1.saveas(Sender: TObject);
begin
        if SaveDialog1.Execute then
        begin
                skriv.Lines.SaveToFile(SaveDialog1.Filename);
        end;
end;

{$R *.dfm}

end.

Unit1.dfm

Kode

object Form1: TForm1
  Left = 618
  Top = 19
  Width = 300
  Height = 300
  Caption = 'MonsterWare WebEdit 1'
  Color = clBtnHighlight
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = 16
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  Menu = menu
  OldCreateOrder = False
  OnClose = luk
  PixelsPerInch = 96
  TextHeight = 16
  object bund: TLabel
    Left = 0
    Top = 230
    Width = 292
    Height = 16
    Align = alBottom
    Alignment = taCenter
    Caption = 'Copyright Thomas Juhl Kappel 2006'
    Color = clBtnFace
    ParentColor = False
  end
  object top: TToolBar
    Left = 0
    Top = 0
    Width = 292
    Height = 29
    ButtonHeight = 25
    Caption = 'Hej'
    Color = clBtnFace
    ParentColor = False
    TabOrder = 1
    object Image1: TImage
      Left = 0
      Top = 2
      Width = 25
      Height = 25
      Picture.Data = {
        0A544A504547496D616765C4020000FFD8FFE000104A46494600010101006000
        600000FFE1001645786966000049492A0008000000000000000000FFDB004300
        080606070605080707070909080A0C140D0C0B0B0C1912130F141D1A1F1E1D1A
        1C1C20242E2720222C231C1C2837292C30313434341F27393D38323C2E333432
        FFDB0043010909090C0B0C180D0D1832211C2132323232323232323232323232
        3232323232323232323232323232323232323232323232323232323232323232
        3232323232FFC0001108001B001703012200021101031101FFC4001F00000105
        01010101010100000000000000000102030405060708090A0BFFC400B5100002
        010303020403050504040000017D010203000411051221314106135161072271
        14328191A1082342B1C11552D1F02433627282090A161718191A25262728292A
        3435363738393A434445464748494A535455565758595A636465666768696A73
        7475767778797A838485868788898A92939495969798999AA2A3A4A5A6A7A8A9
        AAB2B3B4B5B6B7B8B9BAC2C3C4C5C6C7C8C9CAD2D3D4D5D6D7D8D9DAE1E2E3E4
        E5E6E7E8E9EAF1F2F3F4F5F6F7F8F9FAFFC4001F010003010101010101010101
        0000000000000102030405060708090A0BFFC400B51100020102040403040705
        040400010277000102031104052131061241510761711322328108144291A1B1
        C109233352F0156272D10A162434E125F11718191A262728292A35363738393A
        434445464748494A535455565758595A636465666768696A737475767778797A
        82838485868788898A92939495969798999AA2A3A4A5A6A7A8A9AAB2B3B4B5B6
        B7B8B9BAC2C3C4C5C6C7C8C9CAD2D3D4D5D6D7D8D9DAE2E3E4E5E6E7E8E9EAF2
        F3F4F5F6F7F8F9FAFFDA000C03010002110311003F00F68A2A394CC31E4A46DE
        BBDCAE3F206A3DF79FF3C2DFFEFF00B7FF00115858A2C514C8CCA57F7A88AD9E
        88C5863F1028A431F4514500145145007FFFD9}
      OnClick = hr
    end
  end
  object skriv: TRichEdit
    Left = 0
    Top = 29
    Width = 292
    Height = 201
    Align = alClient
    BevelKind = bkSoft
    BorderStyle = bsNone
    Color = clBtnHighlight
    Font.Charset = ANSI_CHARSET
    Font.Color = clWindowText
    Font.Height = 16
    Font.Name = 'Courier New'
    Font.Style = []
    HideScrollBars = False
    ParentFont = False
    ScrollBars = ssVertical
    TabOrder = 0
    OnKeyPress = downloadsite
  end
  object SaveDialog1: TSaveDialog
    DefaultExt = '.txt'
    Filter = 'Tekst dokumenter (*.txt)|.txt|Alle filer (*.*)|'
    Left = 120
  end
  object OpenDialog1: TOpenDialog
    DefaultExt = '.txt'
    Filter = 'Tekst dokumenter (*.txt)|.txt|Alle filer (*.*)|'
    Left = 88
  end
  object menu: TMainMenu
    Left = 48
    object filer: TMenuItem
      Caption = 'Filer'
      object ny: TMenuItem
        Caption = '&Ny'
        GroupIndex = 1
        ShortCut = 16462
        object html: TMenuItem
          Caption = 'HTML dokument'
          OnClick = nyside
        end
      end
      object aaben: TMenuItem
        AutoLineReduction = maAutomatic
        Caption = #197'ben...'
        GroupIndex = 1
        ImageIndex = 1
        OnClick = open
      end
      object gem: TMenuItem
        Caption = 'Gem'
        GroupIndex = 2
        Hint = 'Hej'
      end
      object gemsom: TMenuItem
        AutoLineReduction = maManual
        Caption = 'Gem som'
        GroupIndex = 2
        ShortCut = 16467
        OnClick = saveas
      end
      object afslut: TMenuItem
        Caption = '&Afslut'
        GroupIndex = 2
        OnClick = luk
      end
    end
    object rediger: TMenuItem
      Caption = '&Rediger'
      object programsti: TMenuItem
        Caption = '&Inds'#230't programsti'
        OnClick = programsti
      end
      object markeralt: TMenuItem
        Caption = 'Marker alt'
        OnClick = marker
      end
      object cboard: TMenuItem
        Caption = 'Kopier'
        OnClick = kopier
      end
      object paste: TMenuItem
        Caption = 'Inds'#230't'
        OnClick = indsaet
      end
    end
    object formater: TMenuItem
      Caption = 'F&ormater'
      object skrifttype: TMenuItem
        Caption = 'Skrift&type'
        object verdana: TMenuItem
          Caption = 'Verdana'
          OnClick = setverdana
        end
        object courier: TMenuItem
          Caption = 'Courier new'
          OnClick = setcourier
        end
      end
      object ombrydning: TMenuItem
        Caption = 'Tekstombrydning'
        Checked = True
        OnClick = bryd
      end
    end
    object vis: TMenuItem
      Caption = '&Vis'
      object sti: TMenuItem
        Caption = 'Vis &programsti'
        OnClick = fil
      end
    end
    object hjaelp: TMenuItem
      Caption = '&Hj'#230'lp'
      Enabled = False
      object eltekst: TMenuItem
        Caption = 'Vis tekst'
      end
    end
  end
end

6 svar postet i denne tråd vises herunder
3 indlæg har modtaget i alt 3 karma

Sorter efter stemmer Sorter efter dato

Bruger #3275 @ 28.05.06 09:04

1.736

Går ud fra du bruger en RichEdit. Der kan du bruge RichEdit1.SelAttributes.

Når du har skrevet det popper der en kasse frem hvor du kan se de forskellige muligheder du har, såsom Font, Color osv.
Følgende skulle gerne ændre på den markerede teksts font...(ikke testet).

if FontDialog1.Execute then Richedit1.SelAttributes.Font:= FontDialog1.FontName;

Du skal så lige huske at tilføje en FontDialog til din form.

Indlæg senest redigeret d. 28.05.2006 09:04 af Bruger #3275

Bruger #10031 @ 28.05.06 10:40

Hej Jonas, det er mig igen, selvom jeg denne gang er under et andet brugernavn. Der gik desværre noget galt med min forrige bruger, jeg kunne kun logge ind en gang, og så sagde den, at den ikke kunne finde brugeren for resten af pengene

, og når jeg beder om at få tilsendt mit password sender den til en e-mail, jeg aldrig har indtastet

. Men mange tak for dit svar

Dog skulle den linie, du skrev, ændres til:

Richedit1.SelAttributes.Name := FontDialog1.Font.Name;

Men det fandt jeg hurtigt selv ud af

Jeg har lige et til spørgsmål. Hvis jeg gerne vil ændre på stilen (Font.Style), hvad skal jeg så gøre? Når jeg prøver med følgende linie:

Richedit1.SelAttributes.Style := fsBold;

... Så siger den:
[Error] Unit1.pas(107): Incompatible types: 'TFontStyles' ad 'TFontStyle'
[Fatal Error] WebEdit.dpr(5): Could not compile used unit 'Unit1.pas'

Det betyder vel bare, at fsBold ikke er en gyldig værdi for Style, men så kan jeg ikke lige regne ud hvad jeg skal gøre

Bruger #8254 @ 28.05.06 11:37

280

det er fordi den skal hedde:

Richedit1.SelAttributes.Style := [fsBold];

og ikke:

Richedit1.SelAttributes.Style := fsBold;

Bruger #10031 @ 28.05.06 12:25

Det var bare fordi, jeg prøvede mig frem, har også prøve med kun fsBold, altså uden firkantparenteser, men så får jeg den samme fejl.

Bruger #10031 @ 28.05.06 12:26

Hov, læste dit indlæg omvendt

Troede du mente, der ikke skulle være parenteser, men ja nu virker det

Tak!!

Bruger #8254 @ 28.05.06 12:40

280

Hov, læste dit indlæg omvendt Troede du mente, der ikke skulle være parenteser, men ja nu virker det Tak!!

No problem

Sæt 'lokal' font

Karma barometer (30 dage)

Modtaget

Givet

Favorit hos
Forum tråde
Artikler